home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1994 / MacHack 1994.toast / MacHack™94 / Talks & Papers / Timothy Knox / yerk 3.66 / Toolbox Classes / dialog < prev    next >
Text File  |  1994-06-24  |  6KB  |  189 lines
  1. \ Dialog support
  2. \ 12/22/84  cbd Version 1
  3. \  7/23/85  cbd Fixed get:, added ReturnToModal
  4. \  9/06/85  cdn putText & getText made to work with Control items
  5. \  9/20/85  cdn Added draw:, disp: & ParamText
  6. \  7/10/86  cdn Fixed ReturnToModal, added setProc:
  7. \  7/21/86  cdn Added togItem
  8. \ 10/10/86  cdn Added hilite:
  9. \  5/20/90    rfl    the actual hilite is now a frame: method
  10. \ 11/21/90    rfl    added setUserItem and UserItem class
  11. \ 12/24/90    rfl    dialog items now match array items.  First item in
  12. \                dialog array is at position 1.  Position 0 does nothing. Actions: replaced
  13. \ 10/31/91    rfl    modifed userItem to set its rectangle at set time
  14. \ 12/13/91    rfl    SP added alive:
  15. \  9/28/92    rfl    added portBit: to make consistent with portBit: window
  16. \  5/13/93    rfl    protected getnew
  17. \ 10/22/93    rfl changed setProc to store cfa, do >body in modal:
  18. Decimal
  19.  
  20. : Closer  close: caller ;
  21.  
  22. Int theItem
  23. Var itemHandle
  24. Int itemType
  25.  
  26. 0 value rtm
  27.  
  28. :CLASS  Dialog  <Super X-Array
  29.  
  30.     Int        Resid
  31.     Var        dialPtr
  32.     Var        procPtr
  33.     Int        boldItem
  34.  
  35.     \ ( -- )
  36.     :M  CLOSE:  get: dialPtr  call DisposDialog clear: dialPtr  ;M
  37.  
  38.     :M  ALIVE: ( -- b) get: dialPtr 0 <> ;M
  39.  
  40.     :M  SET: get: dialPtr call setPort ;M
  41.  
  42.     :M  PORTBIT: ( -- abs) get: dialPtr 2+ ;M
  43.  
  44.     \ ( item# -- hndl )  get handle for item#
  45.     :M  HANDLE:  { item# -- hndl }  get: dialPtr  item# makeInt
  46.         abs: itemType  abs: itemHandle  abs: tempRect
  47.         call GetDItem get: itemHandle  ;M
  48.  
  49.     \ draws the frame around the hilit item
  50.     :M  FRAME:     get: boldItem -dup
  51.         IF    savePort get: dialPtr call SetPort 3 3 pack call PenSize
  52.             handle: self drop -4 -4 inset: tempRect
  53.             abs: tempRect 16 16 pack call FrameRoundRect call penNormal restPort
  54.         THEN ;M
  55.  
  56.     \ ( -- )  create dialog from resID
  57.     :M  GETNEW:  0 int: resid 0 -1  call GetNewDialog dup put: dialPtr
  58.         0= classErr" 170
  59.         frame: self    ;M
  60.  
  61.     :M  SHOW: get: dialPtr call showWindow frame: self ;M
  62.  
  63.     \ ( cfa -- )  set dialog proc
  64.     :M  SETPROC:  put: procPtr ;M
  65.  
  66.     \ ( -- )  display as modal dialog
  67.     :M  MODAL:
  68.         BEGIN
  69.             get: procPtr dup IF >body +base THEN abs: theItem call ModalDialog
  70.             get: theItem ( 1-) exec: super
  71.             rtm
  72.         WHILE
  73.             0 -> rtm    \ iterate every time ReturnToModal is executed
  74.         REPEAT
  75.     ;M
  76.  
  77.     \ ( act0 ... actN -- )  set the dialog's action handlers starting at element 1
  78.     :M  ACTIONS: ?ixobj limit 1- 0
  79.         DO limit i- 1- (^elem) !
  80.         LOOP   ;M
  81.  
  82.     \ ( val item# -- )
  83.     :M  PUT:  handle: self  swap makeInt call SetCtlValue   ;M
  84.  
  85.     \ ( item# -- val ) get value for an item#
  86.     :M  GET:   handle: self  >R word0 R>
  87.         call GetCtlValue word0  ;M    \ added word0 cbd 7/17/85
  88.  
  89.     \ ( resID -- )  Associate object with it's resource
  90.     :M  INIT:  put: resID   ;M
  91.  
  92.     :M  PUTRESID: put: resID ;M
  93.  
  94.     \ ( item# -- )  Causes bold outline of the specified item
  95.     :M  HILITE: put: boldItem ;M
  96.  
  97.     \ ( item# -- addr len )  return a text item's text
  98.     :M  GETTEXT: handle: self  buf255 +base   get: ItemType dup 24 and
  99.         IF   drop call GetIText
  100.         ELSE 4 and
  101.              IF   call GetCTitle
  102.              ELSE 2drop 0 buf255 c!        \ user item has no text
  103.             THEN
  104.         THEN
  105.         buf255 count  ;M
  106.  
  107.     \ ( addr len item# -- )  store an item's text
  108.     :M  PUTTEXT: { addr len item# -- } item#  handle: self
  109.         addr len str255   get: ItemType dup 24 and
  110.         IF   drop call SetIText
  111.         ELSE 4 and
  112.              IF   call SetCTitle
  113.              ELSE 2drop                    \ user item has no text
  114.              THEN
  115.         THEN   ;M
  116.  
  117.     \ ( start end item# )  set selection range for text item
  118.     :M  SETSELECT:  { start end item# -- }  get: dialPtr
  119.         item# makeInt start end pack  call SeliText  ;M
  120.  
  121.     \ ( -- )  force drawing of dialog before going to modal:
  122.     :M  DRAW:   get: dialPtr call DrawDialog ;M
  123.  
  124.     \  set user item into dialog; userItem must start with rectangle data
  125.     :M  SETUSERITEM: { userItem -- } item: useritem handle: self drop
  126.         get: tempRect put: userItem
  127.         get: itemType $ 80 and
  128.         IF disable: userItem ELSE enable: userItem THEN
  129.         get: dialPtr getParms: userItem abs: userItem call setDItem ;M
  130.  
  131.     \ ( -- )  Initialize default handlers to close the dialog box
  132.     :M  CLASSINIT:  limit 0 DO 'c closer i to: self LOOP  ;M
  133.  
  134. ;CLASS
  135.  
  136. \ signal modal method to re-enter ModalDialog
  137. : ReturnToModal
  138.     1 -> rtm ;
  139.  
  140. \ Toggle the check box or radio button
  141. : togItem
  142.     get: theItem 1 over get: caller - swap put: caller
  143.     ReturnToModal
  144. ;
  145.  
  146. \ ( addr0 len0 addr1 len1 addr2 len2 addr3 len3 -- )  Substitute Dialog text
  147. : ParamText { \ p1 p2 p3 -- }
  148.      str255 dup -> p3   -base count +
  149.     >str255 dup -> p2   -base count +
  150.     >str255 dup -> p1   -base count +
  151.     >str255     p1 p2 p3 call ParamText
  152. ;
  153.  
  154.  
  155. \    11.21.90    rfl    User Item class for use in dialogs. The proc definition should conform
  156. \                    to IM where the proc draws the item; for example, if the item is a clock,
  157. \                     it wil draw the clock with the current time displayed. When this procedure
  158. \                     is called, the current port will have been set by the Dialog Manager to the
  159. \                     dialog window's grafport. The procedure must have two parameters, a
  160. \                     window pointer and an item number.  If the procedure draws in more than
  161. \                     one dialog window, the ptr tells it which one to draw in. The item number
  162. \                     tells it which item to draw, if it draws more than one. Since itemNo
  163. \                     is an integer, must add word0 to make long.
  164.  
  165. :CLASS userItem <super rect
  166.  
  167.     var myProc
  168.     int    disabled
  169.     int itemNo
  170.  
  171.   :M item:         ( -- n)        get: itemNo ;M
  172.   :M putItem:     ( n --)     put: itemNo ;M
  173.  
  174.   :M disabled?: ( -- int)    int: disabled ;M
  175.  
  176.   :M disable:     ( --)        128 put: disabled ;M
  177.  
  178.   :M enable:     ( --)        clear: disabled ;M
  179.  
  180.   :M setProc:     ( cfaproc --) >body put: myProc ;M
  181.  
  182.   :M getParms:     ( -- int int proc) int: itemNo int: disabled get: myProc +base ;M
  183.  
  184. ;CLASS
  185.  
  186.  
  187. \ example proc to draw Rectangle
  188. \ :PROC drawRect word0 2drop draw: myUserItem ;PROC
  189.